home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / files.swg / 0101_File Select Menu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-03-04  |  23.1 KB  |  801 lines
  1. {
  2.  
  3.    File select menu unit.  Something like a FileListBox unit.
  4.  
  5.    You can select a file from a listbox and change directory or disk if 
  6.    needed (and allowed by the programmer: see the Attribut propertie.)
  7.  
  8.    Remarks
  9.    -------
  10.  
  11.        The (Y1 - Y0) value must be greater than 15.  This means that the
  12.            number of columns of the file select window must be at least of
  13.            16 characters.
  14.        The flTouche will be used in order to know which key the user has
  15.            pressed (13 for Enter key, 59 for F1 key, and so on)
  16.        The Escape key or F10 key will terminate the selection without any
  17.            filename in return of the function
  18.  
  19.                ╔════════════════════════════════════════╗
  20.                ║                                        ║░
  21.                ║          AVONTURE CHRISTOPHE           ║░
  22.                ║              AVC SOFTWARE              ║░
  23.                ║     BOULEVARD EDMOND MACHTENS 157/53   ║░
  24.                ║           B-1080 BRUXELLES             ║░
  25.                ║              BELGIQUE                  ║░
  26.                ║                                        ║░
  27.                ╚════════════════════════════════════════╝░
  28.                ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
  29.  
  30.  
  31.     This is one of my very best unit.  Please send me a postcard if you find
  32.     it usefull.  Thanks in advance!
  33.  
  34.     ==> Hey, is there somebody  in the United States of America?  I have <==
  35.     ==> received postcard from severall country but none from the States <==
  36.     ==>                           Be the first!                          <==
  37.  
  38. }
  39.  
  40. Unit FileList;
  41.  
  42. Interface
  43.  
  44. Const FlTouche : Byte = 0;                 { Key that the user has pressed }
  45.       FName    : String = '';                          { Selected filename }
  46.  
  47. Type Str14 = String[14];
  48.  
  49.      FileListP = Record
  50.        X0, X1, Y0, Y1 : Byte;                         { Window coordinates }
  51.        TAttr          : Byte;                        { Color of the window }
  52.        TBarre         : Byte;                    { Color of the select bar }
  53.        Masque         : Str14;                   { Mask - *.*,  *.BAT, ... }
  54.        Attribut       : Word;    { File attribut: only files matching this }
  55.                                               { attribut will be displayed }
  56.        ChgRep         : Boolean; { Do we must return to the original path? }
  57.      End;
  58.  
  59.  
  60. { The only public function. }
  61.  
  62. Function GetFName (Donnees : FileListP) : String;
  63.  
  64. Implementation
  65.  
  66. Uses Crt, Dos;
  67.  
  68. Type TCadre     = Array [1..8] of Char;
  69.  
  70. Const Double    : Tcadre = ('╔','═','╗','║','║','╚','═','╝');
  71.       MaxFich = 1024;                       { Max number of displayed file }
  72.  
  73. Var NbrFich : Byte;                                 { File number per line }
  74.     NbrF    : Byte;                                     { Working variable }
  75.     NbrFRep : Word;                 { Number of file find in the directory }
  76.     TabF    : Array [1..MaxFich] of Str14;              { The directory... }
  77.     I, J    : Byte;
  78.     DosFich : SearchRec;
  79.     Rep     : Byte;
  80.     Disque  : Byte;
  81.     MaxF    : Byte;
  82.     X_Barre : Byte;
  83.     Y_Barre : Byte;
  84.     wPos     : Byte;
  85.     TBack   : Byte;
  86.     Complet : Boolean;                          { Is there several screen? }
  87.     RepAct  : String;
  88.  
  89. { This function will return True if the disk exist, false otherwise }
  90.  
  91. Function Disque_Exist (Disq: Byte) : Boolean; Assembler;
  92. Asm
  93.              Push Ds
  94.  
  95.              Cmp Disq, 2                  { Test if this is a floppy drive }
  96.              Jbe @@A_or_B
  97.  
  98.              Mov Ax, 4409h                     { Hard disk or network one? }
  99.              Mov Bl, Disq
  100.              Int 21h
  101.  
  102.              Jc  @@False
  103.  
  104.              Mov Ax, 1
  105.              Jmp @@Fin
  106.  
  107. @@A_or_B:    Mov Ah, 44h
  108.              Mov Al, 0Eh
  109.              Mov Bl, Disq
  110.              Int 21h
  111.  
  112.              Cmp Al, Disq
  113.              Jnz @@False
  114.  
  115.              Mov Ax, 1
  116.  
  117.              Jmp @@Fin
  118.  
  119. @@False:     Mov Ax, 1500h                     { Test if the disk is a CD }
  120.              Mov Bx, 0000h
  121.              Int 2Fh
  122.  
  123.              Xor Ax, Ax
  124.  
  125.              Cmp Bx, 0
  126.              Jz @@Fin
  127.  
  128.              Inc Cl
  129.              Cmp Cl, [Disq]
  130.              Jne @@Fin
  131.  
  132.              Mov Ax, 1
  133.  
  134. @@Fin:       Pop Ds
  135.  
  136. End;
  137.  
  138. { Write a string at the specified screen coordinates and with the given
  139.   color attribut
  140. }
  141.  
  142. Procedure WriteStrXY (X, Y, TAttr, TBack : Word; Texte : String);
  143.  
  144. Var Offset   : Word;
  145.     i        : Byte;
  146.     Attr     : Word;
  147.  
  148. Begin
  149.  
  150.     offset := Y * 160 + X Shl 1;
  151.     Attr := ((TAttr+(TBack Shl 4)) shl 8);
  152.  
  153.     For i:= 1 to Length (Texte) do Begin
  154.         MemW[$B800:Offset] := Attr or Ord(Texte[i]);
  155.         Inc (Offset,2);
  156.     End;
  157.  
  158. End;
  159.  
  160. { Return the full filename }
  161.  
  162. Function TrueName (FName : String) : String;
  163.  
  164. Var Temp : String;
  165.     Regs : Registers;
  166.  
  167. Begin
  168.  
  169.   FName := FName + #0;
  170.  
  171.   Regs.Ah := $60;
  172.   Regs.Ds := Seg(FName);
  173.   Regs.Si := Ofs(FName[1]);
  174.   Regs.Es := Seg(Temp);
  175.   Regs.Di := Ofs(Temp[1]);
  176.   Intr ($21, Regs);
  177.  
  178.   DosError := Regs.Ax * ((Regs.Flags And FCarry) shr 7);
  179.  
  180.   Temp[0] := #255;
  181.   Temp[0] := Chr (Pos(#0, Temp) - 1);
  182.  
  183.   If DosError <> 0 then
  184.     Temp := '';
  185.  
  186.   TrueName := Temp;
  187.  
  188. end;
  189.  
  190. { Read a character on the screen at the specified coordinates
  191. }
  192.  
  193. Procedure ReadCar (X, Y : word;Var Attr : Byte; Var Carac : Char);
  194.  
  195. var Car      : ^char;
  196.     Attribut : ^Byte;
  197.  
  198. Begin
  199.  
  200.      New (car);
  201.      Car := ptr ($B800,(Y*160 + X Shl 1));
  202.      Carac := car^;
  203.      New (attribut);
  204.      Attribut := ptr ($B800,(Y*160 + X Shl 1 + 1));
  205.      Attr := attribut^;
  206.  
  207. End;
  208.  
  209. { Draw a cadre
  210. }
  211.  
  212. Procedure Cadre (ColD, LigD, ColF, LigF, Attr, Back : Byte; Cad : TCadre);
  213.  
  214. Var
  215.    X, Y, I, Longueur, Hauteur : Byte;
  216.    sLine : String;
  217.  
  218. Begin
  219.  
  220.      X := WhereX;  Y := WhereY;
  221.      Longueur := (ColF-ColD)-1;
  222.      Hauteur  := (LigF-LigD)-1;
  223.  
  224.      WriteStrXy (ColD, LigD, Attr, Back, Cad[1]);
  225.  
  226.      FillChar (sLine[1], Longueur, Cad[2]);
  227.      sLine [0] := Chr(Longueur);
  228.      WriteStrXy (ColD+1, LigD, Attr, Back, sLine);
  229.  
  230.      WriteStrXy (ColD+1+Longueur, LigD, Attr, Back, Cad[3]);
  231.  
  232.      For i:= 1 To Hauteur Do Begin
  233.          WriteStrXy (ColD, LigD+I, Attr, Back, Cad[4]);
  234.  
  235.          FillChar (sLine[1], Longueur, ' ');
  236.          sLine [0] := Chr(Longueur);
  237.          WriteStrXy (ColD+1, LigD+I, Attr, Back, sLine);
  238.  
  239.          WriteStrXy (ColD+1+Longueur, LigD+I, Attr, Back, Cad[5]);
  240.      End;
  241.  
  242.      WriteStrXy (ColD, LigF, Attr, Back, Cad[6]);
  243.  
  244.      FillChar (sLine[1], Longueur, Cad[7]);
  245.      sLine [0] := Chr(Longueur);
  246.      WriteStrXy (ColD+1, LigF, Attr, Back, sLine);
  247.  
  248.      WriteStrXy (ColD+1+Longueur, LigF, Attr, Back, Cad[8]);
  249.  
  250.      GotoXy (X, Y);
  251.  
  252. End;
  253.  
  254. { Fill the TabF array with the name of each file found in the directory
  255. }
  256.  
  257. Procedure SearchCurrentDir (Masque : Str14; Attribut : Word);
  258.  
  259. Begin
  260.  
  261.    FillChar (TabF, SizeOf (TabF), ' ');             { Initialize the array }
  262.  
  263.    I := 1; Disque := 0;
  264.  
  265.    If Disque_Exist  (1) then Begin TabF[I] := '[A:..]'; Inc (I); Inc (Disque); End;
  266.    If Disque_Exist  (2) then Begin TabF[I] := '[B:..]'; Inc (I); Inc (Disque); End;
  267.    If Disque_Exist  (3) then Begin TabF[I] := '[C:..]'; Inc (I); Inc (Disque); End;
  268.    If Disque_Exist  (4) then Begin TabF[I] := '[D:..]'; Inc (I); Inc (Disque); End;
  269.    If Disque_Exist  (5) then Begin TabF[I] := '[E:..]'; Inc (I); Inc (Disque); End;
  270.    If Disque_Exist  (6) then Begin TabF[I] := '[F:..]'; Inc (I); Inc (Disque); End;
  271.    If Disque_Exist  (7) then Begin TabF[I] := '[G:..]'; Inc (I); Inc (Disque); End;
  272.    If Disque_Exist  (8) then Begin TabF[I] := '[H:..]'; Inc (I); Inc (Disque); End;
  273.    If Disque_Exist  (9) then Begin TabF[I] := '[I:..]'; Inc (I); Inc (Disque); End;
  274.    If Disque_Exist (10) then Begin TabF[I] := '[J:..]'; Inc (I); Inc (Disque); End;
  275.    If Disque_Exist (11) then Begin TabF[I] := '[K:..]'; Inc (I); Inc (Disque); End;
  276.    If Disque_Exist (12) then Begin TabF[I] := '[L:..]'; Inc (I); Inc (Disque); End;
  277.    If Disque_Exist (13) then Begin TabF[I] := '[M:..]'; Inc (I); Inc (Disque); End;
  278.    If Disque_Exist (14) then Begin TabF[I] := '[N:..]'; Inc (I); Inc (Disque); End;
  279.    If Disque_Exist (15) then Begin TabF[I] := '[O:..]'; Inc (I); Inc (Disque); End;
  280.    If Disque_Exist (16) then Begin TabF[I] := '[P:..]'; Inc (I); Inc (Disque); End;
  281.    If Disque_Exist (17) then Begin TabF[I] := '[Q:..]'; Inc (I); Inc (Disque); End;
  282.    If Disque_Exist (18) then Begin TabF[I] := '[R:..]'; Inc (I); Inc (Disque); End;
  283.    If Disque_Exist (19) then Begin TabF[I] := '[S:..]'; Inc (I); Inc (Disque); End;
  284.    If Disque_Exist (20) then Begin TabF[I] := '[T:..]'; Inc (I); Inc (Disque); End;
  285.    If Disque_Exist (21) then Begin TabF[I] := '[U:..]'; Inc (I); Inc (Disque); End;
  286.    If Disque_Exist (22) then Begin TabF[I] := '[V:..]'; Inc (I); Inc (Disque); End;
  287.    If Disque_Exist (23) then Begin TabF[I] := '[W:..]'; Inc (I); Inc (Disque); End;
  288.    If Disque_Exist (24) then Begin TabF[I] := '[X:..]'; Inc (I); Inc (Disque); End;
  289.    If Disque_Exist (25) then Begin TabF[I] := '[Y:..]'; Inc (I); Inc (Disque); End;
  290.    If Disque_Exist (26) then Begin TabF[I] := '[Z:..]'; Inc (I); Inc (Disque); End;
  291.  
  292.                              { Test if we can show path name or only file? }
  293.    If ((Attribut and 16) = 16) then Begin          { We can show path name }
  294.  
  295.       Rep := 0;
  296.  
  297.       FindFirst ('*.*', 16, DosFich);
  298.  
  299.       FindNext (DosFich);
  300.  
  301.       While DosError = 0 do Begin
  302.  
  303.         If (DosFich.Attr and Directory = Directory) then Begin
  304.  
  305.            { We have found a directory }
  306.  
  307.            TabF[I] := '<'+DosFich.Name+'>';
  308.  
  309.            Inc (I);
  310.  
  311.            Inc (Rep);
  312.  
  313.         End;
  314.  
  315.         FindNext (DosFich);
  316.  
  317.       End;
  318.  
  319.    End;
  320.  
  321.    { Clear the attribute bit of Directory only }
  322.  
  323.    Attribut := Attribut and not 16;
  324.  
  325.    { Test if we can show file name or not }
  326.  
  327.    If Not (Attribut = 0) then Begin                { We can show file name }
  328.  
  329.      FindFirst (Masque, Attribut, DosFich);
  330.  
  331.      While DosError = 0 do Begin
  332.  
  333.          If Not (DosFich.Attr and Attribut = 0) then Begin
  334.            TabF[I] := DosFich.Name;
  335.            Inc (I);
  336.          End;
  337.          FindNext (DosFich);
  338.      End;
  339.  
  340.    End;
  341.  
  342.    NbrFRep := I - 1;
  343.  
  344. End;
  345.  
  346. { Write the filename or the path name
  347. }
  348.  
  349. Procedure Prompt (X , Y, TAttr : Byte; Option : Str14);
  350. Begin
  351.    GotoXY (X,Y);
  352.    WriteStrXy (X, Y, TAttr, 0, Option);
  353. End;
  354.  
  355. { Give the possibility to the user to select a name. }
  356.  
  357. Function MChoix (X0, Y0, X1, Y1, X, Y, TAttr, TBarre : Byte) : String;
  358.  
  359. { Handle the select bar
  360. }
  361.  
  362. Procedure SurBrillance (X, TBarre : Byte);
  363.  
  364. Var Attribut : Word;
  365.     Offset   : Word;
  366.     i        : Byte;
  367.     Lig      : Str14;
  368.     Attr     : Byte;
  369.     Chh      : Char;
  370.  
  371. Begin
  372.  
  373.      offset := Y * 160 + X * 2;
  374.  
  375.      Lig := '';
  376.  
  377.      For I := 0 to 12 Do Begin
  378.          ReadCar (X+I, Y, Attr, Chh);
  379.          Lig := Lig + Chh;
  380.      End;
  381.  
  382.      For i:= 1 to 13 do Begin
  383.          MemW[$B800:Offset] := (TBarre shl 8) or Ord(Lig[I]);
  384.          Inc (Offset,2);
  385.      End;
  386.  
  387. End;
  388.  
  389. { Construct the screen with the bar and the file/path name
  390. }
  391.  
  392. Procedure Affiche (X0, Y0 : Byte; Depart : Word);
  393.  
  394. Begin
  395.  
  396.    GotoXy (0,2); NbrF := 0; wPos := Depart;
  397.    X_Barre := X0+2; Y_Barre := Y0+1;
  398.  
  399.    For J := Depart to (Depart+(MaxF*NbrFich)-1) do Begin
  400.  
  401.       If Not (J > NbrFRep) then Prompt (X_Barre, Y_Barre, TAttr, TabF[J]+'                   ')
  402.       Else Prompt (X_Barre, Y_Barre, TAttr, '                      ');
  403.  
  404.       Inc (NbrF);
  405.  
  406.       If Not (NbrF < NbrFich) then Begin
  407.  
  408.          Inc (Y_Barre);
  409.          X_Barre := X0 + 2;
  410.          NbrF := 0;
  411.  
  412.       End
  413.       Else Inc (X_Barre, 13);
  414.  
  415.    End;
  416.  
  417. End;
  418.  
  419. { Main of MChoix function }
  420.  
  421. Var
  422.    Ch : Char;
  423.  
  424. Begin
  425.  
  426.    GotoXy (X, Y);
  427.  
  428.    wPos := 1;
  429.  
  430.    SurBrillance (X, TBarre);
  431.  
  432.    Repeat
  433.  
  434.        Ch := Readkey; If Ch = #0 then Ch := Readkey;
  435.  
  436.        SurBrillance (X, TAttr);
  437.  
  438.        Case Ch Of
  439.  
  440.         #72 : Begin        {UpKey}
  441.                  If Complet then Begin
  442.                    If (wPos - NbrFich - 1 < NbrFRep) then Begin
  443.                       Dec (Y); Dec (wPos, NbrFich);
  444.                    End;
  445.                  End
  446.                  Else
  447.                   If ((Y-1 = Y0) and (Not (wPos - 1 < NbrFich))) then Begin
  448.                         wPos := wPos - (((X - X0) Div 13));
  449.                         Affiche (X0, Y0, Abs(wPos-(NbrFich*MaxF)));
  450.                         X := X0 + 2;
  451.                         Y := Y0 + 1;
  452.                   End
  453.                   Else If Not (wPos - NbrFich - 1 < 0) then Begin
  454.                       Dec (Y); Dec (wPos, NbrFich);
  455.                   End
  456.                   Else If Not (wPos - 1 > NbrFRep) then Begin
  457.                       If (wPos - NbrFich - 1 < NbrFRep) then Begin
  458.                          Dec (Y); Dec (wPos, NbrFich);
  459.                       End;
  460.                    End;
  461.               End;
  462.         #80 : Begin        {DownKey}
  463.                  If Complet then Begin
  464.                    If (wPos + NbrFich -1 < NbrFRep) then Begin
  465.                       Inc (Y); inc (wPos, NbrFich);
  466.                    End
  467.                  End
  468.                  Else
  469.                   If (wPos + NbrFich - 1 < NbrFich*MaxF) then Begin
  470.                       Inc (Y); inc (wPos, NbrFich);
  471.                   End
  472.                   Else If (Y+1 = Y1) then Begin
  473.                         wPos := wPos - (((X - X0) Div 13));
  474.                         Affiche (X0, Y0, wPos+NbrFich);
  475.                         X := X0 + 2;
  476.                         Y := Y0 + 1;
  477.                    End
  478.                    Else If Not (wPos + 1 > NbrFRep) then Begin
  479.                       If (wPos + NbrFich  - 1< NbrFRep) then Begin
  480.                          Inc (Y); inc (wPos, NbrFich);
  481.                       End;
  482.                    End;
  483.               End;
  484.         #77 : Begin        {Right}
  485.                  If Complet then Begin
  486.                    If Not (wPos+1 > NbrFRep) then Begin
  487.                      If Not (X + 13 > (X0+(NbrFich-1)*(13)+2)) then Begin
  488.                       Inc (X, 13); Inc (wPos);
  489.                      End
  490.                      Else If Not (Y > Y0 + (NbrFRep Div NbrFich)) then Begin
  491.                        X := X0 + 2; Inc (Y); Inc (wPos);
  492.                      End;
  493.                    End
  494.                  End
  495.                  Else Begin
  496.                    If Not (wPos+1 > NbrFich*MaxF) then Begin
  497.                      If Not (X + 13 > (X0+(NbrFich-1)*(13)+2)) then Begin
  498.                       Inc (X, 13); Inc (wPos);
  499.                      End
  500.                      Else If Not (Y > Y0 + (NbrFich*MaxF Div NbrFich)) then Begin
  501.                        X := X0 + 2; Inc (Y); Inc (wPos);
  502.                      End;
  503.                    End
  504.                    Else If ((Y+1 = Y1) and ((((X - X0) Div 13 ) +  1) = NbrFich)) then Begin
  505.                         Affiche (X0, Y0, wPos+1);
  506.                         X := X0 + 2;
  507.                         Y := Y0 + 1;
  508.                    End
  509.                    Else If Not (wPos + 1 > NbrFRep) then Begin
  510.                      If Not (X + 13 > (X0+(NbrFich-1)*(13)+2)) then Begin
  511.                       Inc (X, 13); Inc (wPos);
  512.                      End
  513.                      Else If Not (Y > Y0 + (NbrFich*MaxF Div NbrFich)) then Begin
  514.                        X := X0 + 2; Inc (Y); Inc (wPos);
  515.                      End;
  516.                    End;
  517.                  End
  518.               End;
  519.         #75 : Begin        {Left}
  520.                 If Complet then Begin
  521.                   If Not (X = X0+2) then Begin
  522.                      Dec (X, 13); Dec (wPos);
  523.                   End
  524.                   Else If Not (Y < Y0 + 2) then Begin
  525.                      X := X0+((NbrFich-1)*(13)+2);
  526.                      Dec (Y); Dec (wPos);
  527.                   End;
  528.                 End
  529.                 Else
  530.                   If ((Y-1 = Y0) and ((((X - X0) Div 13) = 0)) and Not (wPos = 1)) then Begin
  531.                         wPos := wPos - (((X - X0) Div 13));
  532.                         Affiche (X0, Y0, Abs(wPos-(NbrFich*MaxF)));
  533.                         X := X0 + 2;
  534.                         Y := Y0 + 1;
  535.                   End
  536.                   Else If Not (X = X0+2) then Begin
  537.                        Dec (wPos); Dec (X, 13);
  538.                   End
  539.                   Else If Not (Y < Y0 + 2) then Begin
  540.                      X := X0+((NbrFich-1)*(13)+2);
  541.                      Dec (Y); Dec (wPos);
  542.                   End;
  543.               End;
  544.        End;
  545.  
  546.        GotoXy (X, Y);
  547.  
  548.        SurBrillance (X, TBarre);
  549.  
  550.        { Only Enter key, Escape key or Function key (F1-F10) can stopped
  551.          the selection
  552.        }
  553.  
  554.    Until (Ch in [#13, #27, #59..#68]);
  555.  
  556.    { FLTouche retains the value of the pressed key }
  557.  
  558.    FLTouche := Ord(Ch);
  559.  
  560.    { If the pressed key is not F10 or Escape then return the filename }
  561.  
  562.    If ((Ch = #27) or (Ch = #68)) then MChoix := ''
  563.    Else MChoix := TabF[wPos];
  564.  
  565. End;
  566.  
  567. { The only function public.
  568. }
  569.  
  570. Function GetFName (Donnees : FileListP) : String;
  571.  
  572. Var FinJ   : Word;
  573.     NomRep : String;
  574.  
  575. Begin
  576.  
  577.    TBack := TextAttr;
  578.  
  579.    With Donnees Do Begin
  580.  
  581.      TextAttr := TAttr;
  582.  
  583.      { The window must be at least 17 columns great }
  584.  
  585.      If (X1 - X0 < 16) then X1 := X0 + 16;
  586.  
  587.      { Process the number of file per line }
  588.  
  589.      NbrFich := ((( X1 - X0) - 2) Div 13);
  590.  
  591.      Repeat
  592.  
  593.        { Show the current directory }
  594.  
  595.        SearchCurrentDir (Masque, Attribut);
  596.  
  597.        MaxF := Y1 - Y0 - 1;
  598.  
  599.        { Draw a cadre on the screen
  600.        }
  601.  
  602.        Cadre (X0, Y0, X1, Y1, (TAttr And $F), (TAttr Shr 4), Double);
  603.  
  604.        X_Barre := X0 + 2;
  605.        Y_Barre := Y0 + 1;
  606.  
  607.        NbrF := 0;
  608.  
  609.        If (NbrFRep > MaxF * NbrFich) then Begin
  610.             FinJ := MaxF*NbrFich;
  611.             Complet := False;
  612.        End
  613.        Else Begin
  614.             FinJ := NbrFRep;
  615.             Complet := True;
  616.        End;
  617.  
  618.        For J := 1 to FinJ do Begin
  619.  
  620.          Prompt (X_Barre, Y_Barre, TAttr, TabF[J]);
  621.          Inc (NbrF);
  622.  
  623.          If Not (NbrF < NbrFich) then Begin
  624.  
  625.              Inc (Y_Barre);
  626.              X_Barre := X0 + 2;
  627.              NbrF := 0;
  628.  
  629.          End
  630.          Else Inc (X_Barre, 13);
  631.  
  632.        End;
  633.  
  634.        { Give the possibility to the user to select a file/path name or
  635.          another disk }
  636.  
  637.        FName := MChoix (X0, Y0, X1, Y1, X0+2, Y0+1, TAttr, TBarre);
  638.  
  639.        gotoxy (0,0);
  640.  
  641.        If Not ((FLTouche = 27) or (FLTouche = 68)) then Begin
  642.  
  643.           If Not (wPos > Disque + Rep) then Begin
  644.  
  645.              { The user has pressed the Enter key on a disk specification or
  646.                on a path name }
  647.  
  648.              FName := ''; FLTouche := 0;
  649.  
  650.           End;
  651.  
  652.           If Not (wPos > Disque) then Begin
  653.  
  654.              { Change the active disk }
  655.  
  656.              NomRep := Copy (TabF[wPos], 2, 2);
  657.  
  658.              {$I-}
  659.              ChDir (NomRep);
  660.              {$I+}
  661.  
  662.           End
  663.  
  664.           Else If Not (wPos > Disque+Rep) then Begin
  665.  
  666.              { Change the current path }
  667.  
  668.              NomRep := Copy (TabF[wPos], 2, Length(TabF[wPos]) - 2);
  669.  
  670.              {$I-}
  671.              ChDir (NomRep);
  672.              {$I+}
  673.  
  674.           End;
  675.  
  676.        End
  677.  
  678.        Else ChDir (RepAct);
  679.  
  680.    Until Not ((FLTouche = 0) and (FName = ''));
  681.  
  682.    { Return the selected file name }
  683.  
  684.    If Not (FName = '') then GetFName := TrueName (FName)
  685.    Else GetFName := FName;
  686.  
  687.    If ChgRep then ChDir (RepAct);
  688.  
  689.    End;
  690.  
  691.    TextAttr := TBack;
  692.  
  693. End;
  694.  
  695. Begin
  696.  
  697.     RepAct := TrueName (ParamStr(0));              { Save the current path }
  698.  
  699.     For J := Length (RepAct) Downto 1 do
  700.         If RepAct[J] = '\' then Begin
  701.            I := J;
  702.            J := 1;
  703.         End;
  704.  
  705.     RepAct := Copy (RepAct, 1, I-1);
  706.  
  707. End.
  708.  
  709. {  ----------------------------- cut here -------------------------------- }
  710. {
  711.  
  712.    Example of the file select menu unit
  713.  
  714.  
  715.                ╔════════════════════════════════════════╗
  716.                ║                                        ║░
  717.                ║          AVONTURE CHRISTOPHE           ║░
  718.                ║              AVC SOFTWARE              ║░
  719.                ║     BOULEVARD EDMOND MACHTENS 157/53   ║░
  720.                ║           B-1080 BRUXELLES             ║░
  721.                ║              BELGIQUE                  ║░
  722.                ║                                        ║░
  723.                ╚════════════════════════════════════════╝░
  724.                ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
  725.  
  726. }
  727.  
  728. { Include the FileList unit }
  729.  
  730. Uses Crt, Filelist;
  731.  
  732. { What you must do: declare a variable based on the FileListP type and 
  733.   initialized it in your code }
  734.  
  735. Var FFilelist : FileListP;
  736.     NomF      : String;          { Stored the full name of the selected file }
  737.  
  738. Begin
  739.  
  740.    ClrScr;
  741.  
  742.    { If you set the Attribut  propertie to "AnyFile - VolumeId - Directoy"
  743.      then the user can't  change directory.  So he must select a file from
  744.      the current directory with no possibility to go to other directory or
  745.      disk!  For a list  of value, see  the SearchRec  function in the  DOS 
  746.      unit: values used by my unit are the same. 
  747.  
  748.      Remember that the (Y1 - Y0) value must be greater than 15.  If no, the
  749.      unit will automatically set the Y1 value to (15 - Y0) + Y1.
  750.  
  751.      The Masque propertie is the DOS match pattern: works exactly like the
  752.      SearchRec function. 
  753.  
  754.      The TAttr value represent the color -0 to 255- of the window.  Exactly
  755.      like the Attr CRT variable.
  756.  
  757.      The TBarre value represent the color -0 to 255- of the main bar: the bar
  758.      with it you can select a file, directory or drive. Exactly like the Attr
  759.      CRT variable. 
  760.  
  761.      You the  user  has  select  a  file (and  perhaps changed  drive  and/or 
  762.      directory), the ChgRep  value specifies to your program if the unit must
  763.      go back to  the original path  after the selection or not.  The original 
  764.      path is the current path  just before the GetFName  function is called. }
  765.  
  766.    With FFileList Do Begin
  767.  
  768.        X0       := 6;       { Size                    }
  769.        X1       := 78;      {         of              }
  770.        Y0       := 3;       {             the         }
  771.        Y1       := 17;      {                  window }
  772.        TAttr    := 30;      { window color attribut   }
  773.        TBarre   := 57;      { bar color attribut      }
  774.        Masque   := '*.*';   { File Mask               }
  775.        Attribut := $3F-$08; { AnyFile - VolumeId      }
  776.        ChgRep   := True;    { Return to original path }
  777.  
  778.    End;
  779.  
  780.    { Call the filename selector }
  781.  
  782.    NomF := GetFName (FFileList);
  783.  
  784.    { Here a file has been selected and his full name if stored in NomF. }
  785.  
  786.    ClrScr;
  787.  
  788.    { And show the selected file name.
  789.    
  790.      A file is select only the user press on the Enter key under the filename.
  791.  
  792.      If the user has pressed the Escape Key or a function key (from F1 to F10),
  793.      then the result of the GetFName function is emtpy.  So, in this example, 
  794.      the NomF variable is equal to "" and the flTouche is set to the ASCII 
  795.      value of the Key: 13 if Enter, 27 if Escape, 59 if F1, 60 if F2, ...
  796.  
  797.      The flTouche variable is declared in the unit so don't declared it again }
  798.  
  799.    Writeln ('Selected file : ',NomF,' ... Key pressed (ASCII value) ',flTouche);
  800.  
  801. End.